home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Tele / Pete Johnson / Update 1.0.5<source> Folder / Update.p < prev    next >
Encoding:
Text File  |  1991-11-11  |  5.2 KB  |  193 lines  |  [TEXT/PJMM]
  1. program Update;
  2.  
  3. {    Resource carrier copies its resources to selected target file.    }
  4.  
  5.     var
  6.         Convert: boolean;
  7.  
  8. {-----------------------------------------------------------------    }
  9.  
  10.     procedure ShowRunWindow (var runWindow: WindowPtr; var oldPort: GrafPtr);
  11.  
  12.         var
  13.             rBounds: rect;
  14.  
  15.     begin
  16.         SetCursor(GetCursor(watchCursor)^^);
  17.         GetPort(oldPort);
  18.         if runWindow = nil then
  19.             begin
  20.                 SetRect(rBounds, 15, 50, 190, 95);    {left, top, right, bottom}
  21.                 runWindow := NewWindow(nil, rBounds, 'Update', false, 0, POINTER(-1), false, longint('Pete'));
  22.             end;
  23.         SetPort(runWindow);
  24.         ShowWindow(runWindow);
  25.         textFont(Geneva);
  26.         textSize(9);
  27.         ForeColor(blueColor);
  28.         MoveTo(9, 14);
  29.         DrawString('Update ©1991 by Pete Johnson');
  30.         MoveTo(9, 26);
  31.         DrawString('Glassell Park BBS (213) 254-4852');
  32.         MoveTo(9, 38);
  33.         ForeColor(redColor);
  34.         DrawString('Now copying ')
  35.     end;
  36.  
  37. {-----------------------------------------------------------------    }
  38.  
  39.     procedure HideRunWindow (var runWindow: WindowPtr; var oldPort: GrafPtr);
  40.  
  41.     begin
  42.         HideWindow(runWindow);
  43.         SetPort(oldPort);
  44.         InitCursor
  45.     end;
  46.  
  47. {-----------------------------------------------------------------    }
  48.  
  49.     procedure SwapResources (theType: resType; SourceFRef, TargetFRef, rezCount: integer);
  50.  
  51.         var
  52.             count: integer;
  53.             hRsrc, hOldRsrc: handle;
  54.             rID: integer;
  55.             rType: resType;
  56.             rName: str255;
  57.  
  58.     begin
  59.         UseResFile(SourceFRef);
  60.         for count := 1 to rezCount do
  61.             begin
  62.                 hRsrc := Get1IndResource(theType, count);
  63.                 if hRsrc <> nil then
  64.                     begin
  65.                         GetResInfo(hRsrc, rID, rType, rName);
  66.                         if (rName <> 'don’t install') then                                            {    don't install reserved resources    }
  67.                             begin
  68.                                 DetachResource(hRsrc);
  69.                                 UseResFile(TargetFRef);
  70.                                 if Convert & (rType = 'ICON') & (rName <> 'don’t convert') then    {    change to FICN unless marked        }
  71.                                     rType := 'FICN';
  72.                                 hOldRsrc := Get1Resource(rType, rID);
  73.                                 if hOldRsrc <> nil then
  74.                                     begin
  75.                                         RmveResource(hOldRsrc);
  76. {•       UpdateResFile(TargetFRef);•}
  77.                                         DisposHandle(hOldRsrc);
  78.                                         hOldRsrc := nil;
  79.                                     end;        {if hOldRsrc <> nil}
  80.                                 AddResource(hRsrc, rType, rID, rName);
  81.                                 if ResError = NoErr then
  82.                                     WriteResource(hRsrc);
  83.                             end;    {    if (rName <> 'don’t install')    }
  84.                         DetachResource(hRsrc);
  85.                         DisposHandle(hRsrc);
  86.                         hRsrc := nil;
  87.                     end;        {    if hRsrc <> nil    }
  88.                 UseResFile(SourceFRef);
  89.             end        {for count := 1 to rezCount}
  90.     end;
  91.  
  92. { -------------------------------------------------------------------------------- }
  93.  
  94.     function ClipString (inString: str255; len: integer): str255;
  95.  
  96. {    Sets string length to len    }
  97.  
  98.     begin
  99.         inString := copy(inString, 1, len);        {    make sure it's not longer than len characters            }
  100.         while length(inString) < len do            {    make sure it's not shorter than len characters        }
  101.             inString := concat(inString, ' ');
  102.         ClipString := inString
  103.     end;
  104.  
  105. { -------------------------------------------------------------------------------- }
  106.  
  107.     procedure GetFileTypes (var typeList: SFTypeList; var numTypes: integer);
  108.  
  109.         var
  110.             counter: integer;
  111.             fileType: str255;
  112.  
  113.     begin
  114.         numTypes := 0;
  115.         for counter := 1 to 4 do
  116.             begin
  117.                 GetIndString(fileType, 32001, counter);
  118.                 if fileType <> '' then    {    if it's empty, there are no more STR#s    }
  119.                     begin
  120.                         numTypes := succ(numTypes);
  121.                         typeList[pred(counter)] := ClipString(fileType, 4)
  122.                     end
  123.                 else if numTypes = 0 then        {if empty string and numTypes still 0, make -1 to show all files}
  124.                     numTypes := -1
  125.             end
  126.     end;
  127.  
  128. { -------------------------------------------------------------------------------- }
  129.  
  130.     var
  131.         Err: OSErr;
  132.         where: point;
  133.         reply: SFReply;
  134.         typeList: SFTypeList;
  135.         rezType, tempString: str255;
  136.         SourceRezRef, DestRezRef, counter, numTypes, rezCount: integer;
  137.         finished: boolean;
  138.         runWindow: WindowPtr;
  139.         oldPort: GrafPtr;
  140.         PenLoc: point;
  141.         theRect: rect;
  142.  
  143. begin
  144.     MaxApplZone;
  145.     InitCursor;
  146.     runWindow := nil;
  147.     SourceRezRef := CurResFile;
  148.     GetFileTypes(typeList, numTypes);
  149.     GetIndString(tempString, 32002, 1);
  150.     UprString(tempString, false);
  151.     if tempString[1] = 'Y' then
  152.         Convert := true
  153.     else
  154.         Convert := false;
  155.     finished := false;
  156.     while not finished do
  157.         begin
  158.             SetCursor(arrow);
  159.             counter := 0;
  160.             SFPGetFile(where, '', nil, numTypes, typeList, nil, reply, 32000, nil);
  161.             if reply.good then
  162.                 begin
  163.                     ShowRunWindow(runWindow, oldPort);
  164.                     GetPen(PenLoc);
  165.                     SetRect(theRect, PenLoc.h, PenLoc.v - 9, PenLoc.h + 75, PenLoc.v);
  166.                     DestRezRef := HOpenResFile(reply.vRefNum, 0, reply.fName, fsRdWrPerm);
  167.                     if DestRezRef <> -1 then
  168.                         repeat
  169.                             UseResFile(SourceRezRef);
  170.                             counter := succ(counter);
  171.                             GetIndString(rezType, 32000, counter);
  172.                             if (rezType <> '') then                        {    if it's not empty, STR# is valid        }
  173.                                 begin
  174.                                     rezType := ClipString(rezType, 4);
  175.                                     rezCount := Count1Resources(rezType);
  176.                                     if (rezCount > 0) then
  177.                                         begin
  178.                                             MoveTo(PenLoc.h, PenLoc.v);
  179.                                             EraseRect(theRect);
  180.                                             DrawString(concat(rezType, ' resources'));
  181.                                             SwapResources(rezType, SourceRezRef, DestRezRef, rezCount)
  182.                                         end
  183.                                 end
  184.                         until rezType = '';
  185.                     CloseResFile(DestRezRef);
  186.                     HideRunWindow(runWindow, oldPort)
  187.                 end     {    if reply.good    }
  188.             else
  189.                 finished := true
  190.         end;        {    while not finished    }
  191.     if runWindow <> nil then
  192.         DisposeWindow(runWindow)
  193. end.